home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Demos
/
Collision ⁄⁄⁄ demo ƒ
/
Collision ⁄⁄⁄.p
< prev
next >
Wrap
Text File
|
1996-05-23
|
38KB
|
1,309 lines
{Collision ///}
{}
{This demo demonstrates some alternative ways to use SAT:}
{}
{• The animation is called from the standard event loop (via TransSkel). This slows things down}
{quite a bit (since all other processes are allowed to run), but makes the application background-}
{friendly.}
{• It runs in an ordinary, moveable window. We can, with some effort, do this while still}
{using the fast mode (in which case we would have to restrict window dragging so it stays}
{within the main screen, modify certain global (gSAT.ox ad gSAT.oy), and also limit the}
{horizontal alignment of the window like HyperCard does), but in this demo we just use the}
{slow (safe) mode. }
{• We create sprites from QuickDraw calls instead of cicns.}
{• We use the mask regions of the sprites for better collision detection.}
{• We use a pattern as backkground instead of PICTs.}
{• All the code is in one unit. This might make it less structured, less encapsulated, but I wanted}
{to show you that you don't have to do things exactly the way I do in the other demos.}
{• Using a modified sprite record.}
{• Fixed-point positions}
{}
{However, some variations remain that aren't demonstrated even here:}
{• Calculating the positions of the sprites with the system clock (TickCount or Time Manager) instead of}
{moving them each frame. That approach has some advantages (i.e. constant speed on objects), can easily}
{be used with SAT, but is not as simple.}
program CollisionIII;
uses
{$ifc UNDEFINED THINK_PASCAL}
Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit,{}
Traps, Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources,{}
StandardFile, GestaltEqu, Files, Errors, Controls, TextUtils, QuickDrawText,
{$elsec}
InterfacesUI, {To give Think Pascal some UPI}
{$endc}
TransSkel, SAT;
{A modified sprite record. This should usually go in some globals unit}
{in your project.}
type
C3SpritePtr = ^C3Sprite;
C3Sprite = record
{ Variables that you should change as appropriate }
kind: Integer; { Used for identification. >0: friend. <0 foe }
position: Point;
hotRect, hotRect2: Rect; { Tells how large the sprite is; hotRect is centered around origo }
{hotRect is set by you. hotRect2 is offset to the current position.}
face: FacePtr; { Pointer to the Face (appearance) to be used. }
task: ProcPtr; { Callback-routine, called once per frame. If task=nil, the sprite is removed. }
hitTask: ProcPtr; { Callback in collisions. }
destructTask: ProcPtr; { Called when a sprite is disposed. (Usually nil.) }
clip: RgnHandle;
{ SAT variables that you shouldn't change: }
oldpos: Point; {The 'task' routine is not allowed to change this! }
next, prev: SpritePtr; {You may change them in your own sorting routine, but be careful if you do.}
r, oldr: Rect; {Rectangle telling where to draw. Avoid messing with it.}
oldFace: FacePtr; {Used by RunSAT2}
dirty: Boolean; {Used by RunSAT2}
{Variables for internal use by the sprites. I have edited them, to add fixed-point postions!}
{Since we have edited the record, we must SetSpriteSize immediately}
{after initializing (before any sprites are created)!}
layer: integer; {For layer-sorting. When not used for that, use freely.}
speed: Point; { Can be used for speed, but not necessarily. }
mode: integer; { Usually used for different modes and/or to determine what image to show next. }
fixedPos: Point; {Position * 16}
end;
const
newgameItem = 1;
clearHighItem = 4;
aboutAlrt = 128;
fileMenuRes = 128;
shapeMenuRes = 129;
theWindRes = 128;
kGameTime = 3600; {60 sekunder}
kExtraTime = 180; {3 sekunder}
kLevelBonus = 25;
type
SettingsRec = record
high: Longint;
player: string[5];
end;
SettingsPtr = ^SettingsRec;
SettingsHnd = ^SettingsPtr;
var
settings: SettingsHnd;
fileMenu, shapeMenu: MenuHandle;
gameRunning: Boolean;
gameStartTime, lastSetStartTime: Longint;
setCount: integer;
gMode: integer;
scoreFace, highFace, lastface: FacePtr;
myFace, welcomeFace: FacePtr;
score: Longint;
bgPat: SATPatHandle;
scaledFace: array[0..31] of FacePtr;
procedure Barf;
begin
SATReportStr('Something went wrong. Sorry.');
halt;
end;
{Ljud:}
{Konstruera en snd-resurs artificiellt}
{Rutinen bygger en handle med reserverad plats för ljudet, som sedan värdrutinen kan skapa.}
function CreateSnd (size: longint; var sndH: handle; var dataPek: Ptr): Boolean;
type
mySndRec = packed record
format: integer;
numsynth: integer; {must be 0}
{synth}
synthid: integer;{5}
synthinit: longint;{0}
numcom: integer; {must be 1}
{command}
command: integer;{ $8051}
param1: integer; {0}
param2: longint; { $14}
{sound header}
dataptr: Ptr;
datasize: longint;
samplerate: longint; {22kHz = $56ee8ba3}
loopstart: Ptr;
loopend: Ptr;
encoding: Byte;{0}
basenote: Byte; { $3c}
{data}
ljud: packed array[0..0] of Byte;
end;
msrp = ^mySndRec;
msrh = ^msrp;
var
h: msrh;
begin
h := msrh(NewHandle(sizeof(mySndRec) + size));
if h = nil then
CreateSnd := false
else
begin
HLock(Handle(h)); {Fixar detta buggen med att ljuden ändras?}
with h^^ do
begin
format := 1;
numsynth := 1;
synthid := 5;
synthinit := 0;
numcom := 1;
command := $8051;
param1 := 0;
param2 := $14;
dataptr := @ljud[0];
datasize := size;
samplerate := $56ee8ba3; {div 2 - fast varför köra 11kHz när man synthar?!}
loopstart := dataptr;
loopend := dataptr; {?}
encoding := 0;
basenote := $3c;
dataPek := dataptr; {Utdata}
end; {with}
SndH := handle(h);{utdata}
CreateSnd := true;
end; {if nil else}
end;{CreateSnd}
var
pushH, bippH, baeH: Handle;
{Fixa några bra subrutiner för ljudsyntning?!}
{- Eko}
{- Lågpass och högpass}
{- Sampla upp eller ner?}
{- Frekvensvariation?}
{- Fade in, fade out (mm envelope)}
{Drömmen är förstås FFT, så man kan göra riktigt vass bandspärr, frekvensskift mm.}
{Apropå: kan man inte göra bra ljudkompression med FFT?}
{$PUSH}
{$R-}
{Rutinen som skall bygga de syntetiska ljud vi önskar!}
procedure Synth;
type
ArtRec = record
arr: packed array[0..10000] of Byte;
end;
ArtPtr = ^ArtRec;
var
tmpPtr: ArtPtr;
i: integer;
const
pushSize = 3479;
bippSize = 2959;
baeSize = 20000;
begin
if not CreateSnd(pushSize + 1, pushH, Ptr(tmpptr)) then
CheckNoMem(nil); {EmergencyExit}
for i := 0 to pushSize do
tmpptr^.arr[i] := band(char(random), 127) * (pushSize - i) div pushSize + 128;
for i := 0 to pushSize - 3 do
tmpptr^.arr[i] := (tmpptr^.arr[i] + tmpptr^.arr[i + 1] + tmpptr^.arr[i + 2] + tmpptr^.arr[i + 3]) div 4;
for i := 0 to 64 do
begin
{tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;}
tmpptr^.arr[pushSize - i] := tmpptr^.arr[pushSize - i] * i div 64;
end;
if not CreateSnd(bippSize + 1, bippH, Ptr(tmpptr)) then
CheckNoMem(nil); {EmergencyExit}
for i := 0 to bippSize do
tmpptr^.arr[i] := i mod (i div 171 + 1) mod 127 + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 171 + 1) + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 17 + 1) + 128; {maipp}
{tmpptr^.arr[i] := band(i, 63) + 128;}
for i := 0 to 64 do
begin
tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;
tmpptr^.arr[bippSize - i] := tmpptr^.arr[bippSize - i] * i div 64;
end;
if not CreateSnd(baeSize + 1, baeH, Ptr(tmpptr)) then
CheckNoMem(nil); {EmergencyExit}
for i := 0 to baeSize do
tmpptr^.arr[i] := (i div 5) mod (i div 1571 + 1) mod 127 + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 171 + 1) + 128; {mjiioo}
{tmpptr^.arr[i] := i mod (i div 17 + 1) + 128; {maipp}
{tmpptr^.arr[i] := band(i, 63) + 128;}
for i := 0 to baeSize - 3 do
tmpptr^.arr[i] := (tmpptr^.arr[i] + tmpptr^.arr[i + 1] + tmpptr^.arr[i + 2] + tmpptr^.arr[i + 3]) div 4;
for i := 0 to 64 do
begin
tmpptr^.arr[i] := tmpptr^.arr[i] * i div 64;
tmpptr^.arr[baeSize - i] := tmpptr^.arr[baeSize - i] * i div 64;
end;
end;
{$POP}
procedure DoAbout;
begin
if 1 = Alert(aboutAlrt, nil) then
;
end;
{Two handly routines from my dialog utilities unit.}
procedure SetTextDItem (theDialog: DialogPtr; itemNo: integer; theString: Str255);
var
kind: integer;
item: ControlHandle;
box: Rect;
begin
GetDialogItem(theDialog, itemNo, kind, Handle(item), box);
{Check kind}
kind := BitAnd(kind, 127);
case kind of
8, 16: {statText, editText}
SetDialogItemText(handle(item), theString);
0, 1, 2, 4, 5, 6: {button, checkbox, radio - men vad är 4?}
SetControlTitle(item, theString);
otherwise {Övriga har ingen text man kan sätta}
SysBeep(1);
end;{case}
end;
function GetTextDItem (theDialog: DialogPtr; itemNo: integer): Str255;
var
kind: integer;
item: ControlHandle;
box: Rect;
tmpStr: Str255;
begin
GetDialogItem(theDialog, itemNo, kind, Handle(item), box);
{Check kind}
kind := BitAnd(kind, 127);
tmpStr := '';
case kind of
8, 16: {statText, editText}
GetDialogItemText(handle(item), tmpStr);
0, 1, 2, 4, 5, 6: {button, checkbox, radio…?}
GetControlTitle(item, tmpStr);
otherwise {Övriga har ingen text man kan sätta}
SysBeep(1);
end;{case}
GetTextDItem := tmpStr;
end;
function MyNumToString (l: longint): Str255;
var
tmpStr: Str255;
begin
NumToString(l, tmpStr);
MyNumToString := tmpStr;
end;
{Make the new high score dialog}
procedure AskHigh;
const
highDlogID = 129;
var
dialog: DialogPtr;
oldPort: GrafPtr;
itemHit: integer;
str: str255;
begin
GetPort(oldPort);
dialog := GetNewDialog(highDlogID, nil, WindowPtr(-1));
ShowWindow(dialog);
SelectWindow(dialog);
SetPort(dialog);
SetTextDItem(dialog, 3, settings^^.player);
SelectDialogItemText(dialog, 3, 0, 32767);
itemHit := -1;
while (itemHit <> 1) and (itemHit <> 2) do { 1=ok, 2=cancel }
ModalDialog(nil, itemHit);
if itemHit = 1 then
begin
str := GetTextDItem(dialog, 3);
if length(str) > 5 then
str[0] := char(5); {snabbaste sättet att korta den!}
settings^^.player := str;
settings^^.high := score;
end;
DisposeDialog(dialog);
SetPort(oldPort);
end;
{Reuseable sprite movement routine, called from all sprite handling routines. Some sprites use this}
{as handling routine.}
procedure SATBounce (me: SpritePtr);
begin
me^.position.h := me^.position.h + me^.speed.h;
me^.position.v := me^.position.v + me^.speed.v;
if me^.position.h < 0 then
me^.speed.h := abs(me^.speed.h);
if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
me^.speed.h := -abs(me^.speed.h);
if me^.position.v < 0 then
me^.speed.v := abs(me^.speed.v);
if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
me^.speed.v := -abs(me^.speed.v);
end;
{The same but using fixed-point position, as in HandlePlayer}
procedure SATFixedBounce (me: C3SpritePtr);
begin
me^.fixedPos.h := me^.fixedPos.h + me^.speed.h;
me^.fixedPos.v := me^.fixedPos.v + me^.speed.v;
me^.position.h := BSR(me^.fixedPos.h, 4); {Shift left 4 steps, i.e. div 16}
me^.position.v := BSR(me^.fixedPos.v, 4);
{Since BSR isn't aritmetic shift, a negative fixedPos will unfortunately result in}
{a very large positive position. This must be accounted for when checking borders}
{- or we could use div, but that is slower.}
if me^.fixedPos.h < 0 then
begin
me^.speed.h := abs(me^.speed.h);
me^.position.h := 0;
end
else if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
me^.speed.h := -abs(me^.speed.h);
if me^.fixedPos.v < 0 then
begin
me^.speed.v := abs(me^.speed.v);
me^.position.v := 0;
end
else if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
me^.speed.v := -abs(me^.speed.v);
end;
procedure HandleTheSprite (me: C3SpritePtr);
begin
if me^.speed.h = 0 then
me^.speed.h := SATRand(32) - SATRand(32);
if me^.speed.v = 0 then
me^.speed.v := SATRand(32) - SATRand(32);
if me^.face = nil then
begin
me^.face := myFace;
if me^.face <> nil then
me^.hotRect := me^.face^.iconMask.bounds;
end;
SATFixedBounce(me);
end;
procedure RedrawScoreFace;
begin
SATSetPortFace(scoreFace);
EraseRect(scoreFace^.iconMask.bounds);
MoveTo(2, 14);
ForeColor(blackColor);
DrawString('Score:');
SATDrawLong(score);
ForeColor(whiteColor);
MoveTo(0, 12);
DrawString('Score:');
SATDrawLong(score);
ForeColor(blackColor);
SATSetPortScreen;
SATSetPortMask(scoreFace);
EraseRect(scoreFace^.iconMask.bounds);
MoveTo(0, 12);
DrawString('Score:');
SATDrawLong(score);
MoveTo(2, 14);
DrawString('Score:');
SATDrawLong(score);
SATSetPortScreen;
SATChangedFace(scoreFace);
end;
procedure RedrawHighFace;
var
str: Str255;
begin
str := stringof('High score:', MyNumToString(settings^^.high), ' by ', settings^^.player);
SATSetPortFace(highFace);
EraseRect(highFace^.iconMask.bounds);
MoveTo(2, 14);
ForeColor(blackColor);
DrawString(str);
ForeColor(whiteColor);
MoveTo(0, 12);
DrawString(str);
ForeColor(blackColor);
SATSetPortScreen;
SATSetPortMask(highFace);
EraseRect(highFace^.iconMask.bounds);
MoveTo(0, 12);
DrawString(str);
MoveTo(2, 14);
DrawString(str);
SATSetPortScreen;
SATChangedFace(highFace);
end;
procedure RedrawLastFace;
begin
SATSetPortFace(lastface);
EraseRect(lastface^.iconMask.bounds);
MoveTo(2, 14);
DrawString('Last score:');
SATDrawLong(score);
ForeColor(whiteColor);
MoveTo(0, 12);
DrawString('Last score:');
SATDrawLong(score);
ForeColor(blackColor);
SATSetPortScreen;
SATSetPortMask(lastface);
EraseRect(lastface^.iconMask.bounds);
MoveTo(0, 12);
DrawString('Last score:');
SATDrawLong(score);
MoveTo(2, 14);
DrawString('Last score:');
SATDrawLong(score);
SATSetPortScreen;
SATChangedFace(lastface);
end;
var
playerFace: array[0..15] of FacePtr;
playerSpeed: array[0..15] of Point;
{Redraw all player faces. This is separated from InitPlayerFaces since it must be called on}
{depth changes.}
procedure ReDrawPlayerFaces;
const
totalAngle = 240;
var
i: integer;
r, r1, r2, ri: Rect;
reg1, reg2: RgnHandle;
pol: PolyHandle;
begin
SetRect(r, 0, 0, 40, 40); {Total face size}
SetRect(r1, 0, 0, 38, 38); {Colored part}
SetRect(ri, 9, 9, 29, 29); {Colored part, inner circle}
SetRect(r2, 2, 2, 40, 40); {Shadow}
for i := 0 to 15 do
begin
reg1 := NewRgn;
reg2 := NewRgn;
{Generate shape}
SATSetPortMask(playerFace[i]);
PaintArc(r1, i * 360 div 16 - (360 - totalAngle) div 2, totalAngle);
EraseArc(ri, i * 360 div 16 - (360 - totalAngle) div 2, totalAngle); {360-graders-skala}
{$IFC GENERATINGPOWERPC }
if noErr <> BitMapToRegion(reg1, playerFace[i]^.iconMask) then{}
;
{$ELSEC}
if noErr <> BitMapToRegionGlue(reg1, playerFace[i]^.iconMask) then{}
;
{$ENDC}
CopyRgn(reg1, reg2);
OffsetRgn(reg2, 2, 2);
{Draw face}
SATSetPortFace(playerFace[i]);
EraseRect(playerFace[i]^.iconMask.bounds);
ForeColor(blackColor);
PaintRgn(reg2); {black "Shadow"}
ForeColor(cyanColor);
if gSAT.initDepth > 1 then
PaintRgn(reg1) {If we run in color, fill it completely with cyan}
else
{$IFC UNDEFINED THINK_PASCAL}
FillRgn(reg1, qd.ltGray); {If we run in b/w, a gray pattern looks nicer}
{$ELSEC}
FillRgn(reg1, ltGray); {If we run in b/w, a gray pattern looks nicer}
{$ENDC}
ForeColor(blueColor);
FrameRgn(reg1);
ForeColor(blackColor);
{Draw mask}
SATSetPortMask(playerFace[i]);
EraseRect(playerFace[i]^.iconMask.bounds);
PaintRgn(reg1);
PaintRgn(reg2);
SATSetPortScreen;
SATChangedFace(playerFace[i]);
DisposeRgn(reg1);
DisposeRgn(reg2);
end;
end;
{Create all player faces.}
procedure InitPlayerFaces;
var
i: integer;
r: Rect;
begin
{We use crude approximations to the sine/cosine functions we really want.}
{A real game might init the table by using sine and cosine for real, but I don't}
{want to make this harder to read than it already is. A real game would also}
{use more than 16 directions, say 32 or even 64.}
SetPt(playerSpeed[6], 0, -6);
SetPt(playerSpeed[7], 2, -5);
SetPt(playerSpeed[8], 4, -4);
SetPt(playerSpeed[9], 5, -2);
SetPt(playerSpeed[10], 6, 0);
SetPt(playerSpeed[11], 5, 2);
SetPt(playerSpeed[12], 4, 4);
SetPt(playerSpeed[13], 2, 5);
SetPt(playerSpeed[14], 0, 6);
SetPt(playerSpeed[15], -2, 5);
SetPt(playerSpeed[0], -4, 4);
SetPt(playerSpeed[1], -5, 2);
SetPt(playerSpeed[2], -6, 0);
SetPt(playerSpeed[3], -5, -2);
SetPt(playerSpeed[4], -4, -4);
SetPt(playerSpeed[5], -2, -5);
SetPt(playerSpeed[6], 0, -32);
SetPt(playerSpeed[7], 14, -28);
SetPt(playerSpeed[8], 22, -22);
SetPt(playerSpeed[9], 28, -14);
SetPt(playerSpeed[10], 32, 0);
SetPt(playerSpeed[11], 28, 14);
SetPt(playerSpeed[12], 22, 22);
SetPt(playerSpeed[13], 14, 28);
SetPt(playerSpeed[14], 0, 32);
SetPt(playerSpeed[15], -14, 28);
SetPt(playerSpeed[0], -22, 22);
SetPt(playerSpeed[1], -28, 14);
SetPt(playerSpeed[2], -32, 0);
SetPt(playerSpeed[3], -28, -14);
SetPt(playerSpeed[4], -22, -22);
SetPt(playerSpeed[5], -14, -28);
SetRect(r, 0, 0, 40, 40); {Total face size}
for i := 0 to 15 do
begin
playerFace[i] := SATNewFace(r);
SATChangedFace(playerFace[i]);
end;
RedrawPlayerFaces;
end;
procedure HandlePlayer (me: C3SpritePtr);
begin
me^.mode := gMode;
me^.face := playerFace[me^.mode];
me^.fixedPos.h := me^.fixedPos.h + playerSpeed[me^.mode].h;
me^.fixedPos.v := me^.fixedPos.v + playerSpeed[me^.mode].v;
me^.position.h := BSR(me^.fixedPos.h, 4); {Shift left 4 steps, i.e. div 16}
me^.position.v := BSR(me^.fixedPos.v, 4);
if me^.fixedPos.h < 0 then
begin
me^.position.h := 0;
me^.fixedPos.h := 0;
{gMode := BitAnd(BitAnd(4 - gMode, 15) + 4, 15);}
end;
if me^.position.h > gSAT.offSizeH - me^.hotRect.right then
begin
me^.position.h := gSAT.offSizeH - me^.hotRect.right;
me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
{gMode := BitAnd(BitAnd(4 - gMode, 15) + 4, 15);}
end;
if me^.fixedPos.v < 0 then
begin
me^.position.v := 0;
me^.fixedPos.v := 0;
{gMode := BitAnd(-gMode, 15);}
end;
if me^.position.v > gSAT.offSizeV - me^.hotRect.bottom then
begin
me^.position.v := gSAT.offSizeV - me^.hotRect.bottom;
me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
{gMode := BitAnd(-gMode, 15);}
end;
end;
{Get a vector from center to center of two sprites}
function Vector (s1, s2: SpritePtr): Point;
begin
Vector.h := s1^.position.h + s1^.face^.iconMask.bounds.right div 2 - s2^.position.h - s2^.face^.iconMask.bounds.right div 2;
Vector.v := s1^.position.v + s1^.face^.iconMask.bounds.right div 2 - s2^.position.v - s2^.face^.iconMask.bounds.right div 2;
end;
{Squared distance between centers of two sprites}
function Dist2 (s1, s2: SpritePtr): Longint;
var
v: Point;
begin
v := Vector(s1, s2);
Dist2 := v.h * v.h + v.v * v.v;
end;
procedure CreatePill;
forward;
{***Check for hits based on regions - reuseable procedure!***}
function RegionHitTest (s1, s2: SpritePtr): Boolean;
var
r1, r2: RgnHandle;
begin
{We know that out hotRects coincide. However, that doesn't mean that we must take it as a}
{collision! Rather, we can do more processing here to decide whether or not it was a collision.}
{In this case, we copy the mask regions of each sprite, offset them to the proper positions,}
{and check if they, too, overlap!}
{}
{Do you think we are doing double work, both dealing with hotRects and the regions? If you do,}
{let me explain some more. The idea is that SAT checks the hotRects for you, which takes away}
{next to all false hits. Checking hotRects is *fast*, so that's what we can afford to do all-to-all}
{(or all-to-near, depending on the chosen search mode). Once a *possible* collision is detected,}
{we can spend some time analyzing it further!}
{First of all, let's do some error checking. We could also have done this when loading the faces.}
{Most programs won't have to bother whether or not the regions have been generated}
{successfully, but when using them this way, they must exist or we may get a crash.}
if (s1^.face^.maskRgn = nil) or (s2^.face^.maskRgn = nil) then
begin
SATReportStr('Error: No mask region!');
exit(RegionHitTest);
end;
{Make copies of the mask regions and offset them to the proper places.}
r1 := NewRgn;
r2 := NewRgn;
CopyRgn(s1^.face^.maskRgn, r1);
CopyRgn(s2^.face^.maskRgn, r2);
OffsetRgn(r1, s1^.position.h, s1^.position.v);
OffsetRgn(r2, s2^.position.h, s2^.position.v);
SectRgn(r1, r2, r1); {Is there any overlap?}
{If empty, no collision, otherwise, handle the collision!}
RegionHitTest := not EmptyRgn(r1);
DisposeRgn(r1);
DisposeRgn(r2);
end;
{Collision handling for the player sprite}
procedure HitPlayer (me, him: SpritePtr);
var
v: Point;
begin
if RegionHitTest(me, him) then {Do the sprites *really* overlap?}
begin
if Dist2(me, him) > 60 then
begin
{Hit too far out, so let's call it the outside. Bounce away him.}
{We could make more efforts here for a good bounce.}
him^.position.h := him^.position.h + me^.speed.h;
him^.speed.h := -him^.speed.h + me^.speed.h;
him^.position.v := him^.position.v + me^.speed.v;
him^.speed.v := -him^.speed.v + me^.speed.v;
{Finally, make sure the other is moving *away* from us!}
{And when we're at it, why not move it just a little, too?}
{Yuck, this is ugly! Yup, careless programming. Hack, hack!}
v := Vector(me, him);
if v.h > 0 then
begin
if him^.speed.h > 0 then
him^.speed.h := -him^.speed.h;
him^.position.h := him^.position.h - 1;
end
else
begin
if v.h < 0 then
if him^.speed.h < 0 then
him^.speed.h := -him^.speed.h;
him^.position.h := him^.position.h + 1;
end;
if v.v > 0 then
begin
if him^.speed.v > 0 then
him^.speed.v := -him^.speed.v;
him^.position.v := him^.position.v - 1;
end
else
begin
if v.v < 0 then
if him^.speed.v < 0 then
him^.speed.v := -him^.speed.v;
him^.position.v := him^.position.v + 1;
end;
end
else
begin
{This looks like inside! Let's eat him.}
score := score + 1;
RedrawScoreFace;
him^.task := nil;
setCount := setCount - 1;
if setCount < 2 then
CreatePill; {There should always be pills left!}
SATSoundPlay(bippH, 1, true);
end; {Dist2}
end; {RegionHitTest}
end;
{Create the score face}
procedure InitScoreFace;
var
r: Rect;
begin
SetRect(r, 0, 0, 80, 14);{}
scoreFace := SATNewFace(r);
SATChangedFace(scoreFace);
SetRect(r, 0, 0, 200, 16);{}
highFace := SATNewFace(r);
SATChangedFace(highFace);
SetRect(r, 0, 0, 120, 16);{}
lastFace := SATNewFace(r);
SATChangedFace(lastFace);
end;
procedure SetupDummy (me: SpritePtr);
begin
me^.task := @SATBounce;
end;
procedure SetupSmall (me: C3SpritePtr);
begin
me^.face := myFace;
me^.hotRect := me^.face^.iconMask.bounds;
me^.task := @HandleTheSprite;
me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
end;
procedure SetupPlayer (me: C3SpritePtr);
begin
me^.face := playerFace[0];
me^.hotRect := me^.face^.iconMask.bounds;
me^.task := @HandlePlayer;
me^.hitTask := @HitPlayer;
me^.fixedPos.h := BSL(me^.position.h, 4); {*16}
me^.fixedPos.v := BSL(me^.position.v, 4); {*16}
end;
procedure CreatePill;
var
sp: SpritePtr;
begin
sp := SATNewSprite(-1, SATRand(gSAT.offSizeH - 32), SATRand(gSAT.offSizeV - 32), @SetupSmall);
setCount := setCount + 1; {Number of active pills}
end;
procedure NewSet;
var
sp: SpritePtr;
i: integer;
begin
{Kill all sprites}
while gSAT.sRoot <> nil do
SATKillSprite(gSAT.sRoot);
{Create the pills}
for i := 1 to 10 do
CreatePill;
if settings^^.high > 7 then
for i := 8 to settings^^.high do
CreatePill;
sp := SATNewSprite(0, SATRand(gSAT.offSizeH - 32), SATRand(gSAT.offSizeV - 32), @SetupDummy);
RedrawScoreFace;
sp^.face := scoreFace;
repeat
sp^.speed.h := SATRand(5) - 2
until sp^.speed.h <> 0;
repeat
sp^.speed.v := SATRand(3) - 1
until sp^.speed.v <> 0;
sp^.hotRect := sp^.face^.iconMask.bounds;
{Hoppsan- fattas nåt!}
sp := SATNewSprite(1, (gSAT.offSizeH - 32) div 2, (gSAT.offSizeV - 32) div 2, @SetupPlayer);
gMode := 0;
SATBackChanged(gSAT.bounds);
FlushEvents(6, 0); {Glöm klick från förra uppsättningen!}
if not (TickCount > gameStartTime + kGameTime) then {Om tiden INTE är ute så skall vi ändra!}
lastSetStartTime := TickCount;
end;
{An example of how you can (with some effort) scale a sprite.}
procedure ScaleWelcomeFace;
var
srcFacePort, destFacePort: GrafPtr;
i: integer;
scaleRect: Rect;
begin
{Get the rectangle of the original}
scaleRect := welcomeFace^.iconMask.bounds;
for i := 0 to 31 do
begin
{SetPortFace to the source. This must be done each turn since ChangedFace changes it.}
SATSetPortFace(welcomeFace); {Set the FIRST of SAT's two internal face-ports to the original face.}
GetPort(srcFacePort); {Get the port.}
{Modify the size}
scaleRect.bottom := scaleRect.bottom - 2;
scaleRect.right := scaleRect.right - 2;
{Create the new face}
if scaledFace[i] = nil then
scaledFace[i] := SATNewFace(scaleRect);
{Get a port to it}
SATSetPortFace2(scaledFace[i]); {Set the SECOND of SAT's two internal face ports to the new face.}
GetPort(destFacePort); {Get the port.}
{Copy the image}
CopyBits(srcFacePort^.portBits, destFacePort^.portBits, welcomeFace^.iconMask.bounds, scaleRect, srcCopy + ditherCopy, nil);
CopyBits(welcomeFace^.iconMask, scaledFace[i]^.iconMask, welcomeFace^.iconMask.bounds, scaleRect, srcCopy, nil);
SATChangedFace(scaledFace[i]); {Done changing it. Tell SAT that it may do whatever it needs.}
end; {for}
end; {ScaleWelcomeFace}
procedure WindUpdate (whatever: Boolean);
var
savePort: GrafPtr;
saveDev: GDHandle;
begin
if SATDepthChangeTest then
{IMPORTANT! We must redraw all internally generated faces on depth changes!}
begin
ReDrawPlayerFaces;
RedrawScoreFace;
RedrawHighFace;
RedrawLastFace;
ScaleWelcomeFace;
{We also have to redraw the background, since it's not a PICT (in which case that is automatic)}
GetPort(savePort);
if gSAT.colorFlag then
saveDev := GetGDevice;
SATSetPortBackScreen;
SATPenPat(bgPat);
PaintRect(gSAT.backScreen.port^.portRect);
PenNormal;
CopyBits(gSAT.backScreen.port^.portBits, gSAT.offScreen.port^.portBits, gSAT.offScreen.port^.portRect, gSAT.offScreen.port^.portRect, srcCopy, nil);
SetPort(savePort);
if gSAT.colorFlag then
SetGDevice(saveDev);
end;
SATRedraw;
end;
procedure WindClose;
begin
SkelWhoa;
end;
procedure WindMouse (where: Point; when: Longint; modifiers: integer);
var
found, sp: SpritePtr;
anyLeft: Boolean;
myRegion: RgnHandle;
begin
{Not needed for the game, but note that we can check the mask region of a sprite}
{towards a mouse click as well as a colliding sprite! For demonstrating this, mouse}
{clicks are processed, and if a sprite is hit, a SysBeep is made. Try this by clicking}
{in and around the "Hello" sprite!}
myRegion := NewRgn;
sp := gSAT.sRoot;
found := nil;
while sp <> nil do {Search through the sprite list}
begin
if PtInRect(where, sp^.r) then {We are in the rect!}
if sp^.face <> nil then {Does it have a face at all? Remember it's legal not to have one!}
if sp^.face^.maskRgn <> nil then {Does that face have a mask region? It should, but…}
begin
CopyRgn(sp^.face^.maskRgn, myRegion); {Copy the mask region}
OffsetRgn(myRegion, sp^.position.h, sp^.position.v); {Offset it to the position of the sprite}
if PtInRgn(where, myRegion) then {Are we in the region?}
found := sp; {Yes!}
end;
sp := sp^.next; {Next sprite…}
end;
if found <> nil then
SysBeep(1); {We hit something. Tell us so.}
DisposeRgn(myRegion);
end;
procedure WindKey (theKey: char; theMods: integer);
begin
{Hard-coded keys; real games have customizable keys.}
case theKey of
',', 'z', '1':
gMode := BitAnd(gMode - 1, 15);
'.', 'x', '2':
gMode := BitAnd(gMode + 1, 15);
otherwise
end; {case}
ObscureCursor; {Hide the cursor until the mouse is moved.}
end;
procedure SetupSAT (theWind: WindowPtr);{Calls SATCustomInit and paints the background with a pattern}
var
savePort: SATPort;
r: Rect;
begin
SATGetPort(savePort);
SetPort(theWind);
r := theWind^.portRect;
OffsetRect(r, -r.left, -r.top);
SATCustomInit(0, 0, r, theWind, nil, false, false, false, true, false); {Nytt försök!}
{SATCustomInit(0, 0, theWind^.portRect, theWind, nil, false, false, false, true, false); {Nytt försök!}
{We use a customized sprite record! Thus, we must SetSpriteSize before creating sprites!}
SATSetSpriteRecSize(sizeof(C3Sprite));
if bgPat = nil then
bgPat := SATGetPat(128);
if bgPat = nil then
Barf;
SATSetPortBackScreen;
SATPenPat(bgPat);
PaintRect(gSAT.backScreen.port^.portRect);
PenNormal;
CopyBits(gSAT.backScreen.port^.portBits, gSAT.offScreen.port^.portBits, gSAT.offScreen.port^.portRect, gSAT.offScreen.port^.portRect, srcCopy, nil);
SATSetPort(savePort);
CopyBits(gSAT.backScreen.port^.portBits, gSAT.wind.port^.portBits, gSAT.wind.port^.portRect, gSAT.wind.port^.portRect, srcCopy, nil);
if SkelWindow(theWind, @WindMouse, @WindKey, @WindUpdate, nil, @WindClose, nil, nil, false) then
;
end;
procedure SetupWindow;
var
slaskWind, theWind: WindowPtr;
tmpWorld: SysEnvRec;
tmpCol: Boolean;
{r: Rect;}
{peek: WindowPeek;}
begin
tmpCol := false;
if noErr = SysEnvirons(1, tmpWorld) then
tmpCol := tmpWorld.hasColorQD;
if tmpCol then
theWind := GetNewCWindow(theWindRes, nil, WindowPtr(-1))
else
theWind := GetNewWindow(theWindRes, nil, WindowPtr(-1));
{peek := WindowPeek(theWind);}
if theWind = nil then
Barf;
{MoveWindow(theWind, 50, 50, false);}
{r := WindowPeek(theWind)^.contRgn^^.rgnBBox;}
{slaskWind := theWind;}
SetupSAT(theWind); {Calls SATCustomInit and paints the background with a pattern}
SATSetPortScreen;
ShowWindow(gSAT.wind.port);
SelectWindow(gSAT.wind.port);
SATRedraw;
end;
{The task the welcome sprite has while zooming.}
procedure ZoomWelcome (me: SpritePtr);
begin
me^.mode := me^.mode + 1;
{Compensate for the size change to make it centered in one place.}
me^.position.h := me^.position.h - 1;
me^.position.v := me^.position.v - 1;
if me^.mode >= 32 then
begin
me^.face := welcomeFace;
me^.task := @SATBounce;
end
else
me^.face := scaledFace[32 - me^.mode];
end;
{Initialize faces.}
procedure InitSpriteFaces;
var
i: integer;
begin
myFace := SATGetFace(128);
if myFace = nil then
Barf;
welcomeFace := SATGetFace(138);
if welcomeFace = nil then
Barf;
{We don't HAVE to bail out when a face fails to load - the program will stll wor, but that face will}
{not be visible.}
ScaleWelcomeFace;
end;
var
lastTime: Longint;
{DirtyWork is called from TransSkel}
procedure DirtyWork;
var
sp: SpritePtr;
ph: PicHandle;
r: Rect;
savePort: GrafPtr;
saveDev: GDHandle;
begin
{We can check TickCount as usual, since we never know how often we get null events.}
if lastTime + 1 < TickCount then
begin
SATRun(false);
lastTime := tickCount;
end;
if gameRunning then
begin
{Timebar}
GetPort(savePort);
if gSAT.colorFlag then
saveDev := GetGDevice;
SATSetPortBackScreen;
{I *should* change only the part that actually changes!}
r := gSAT.wind.port^.portRect;
SATBackChanged(r);
r.right := 5;
r.top := r.bottom * (lastSetStartTime + kGameTime - TickCount) div kGameTime;
ForeColor(redColor); {Quickest way to get a color.}
PaintRect(r);
r.bottom := r.top;
r.top := 0;
SATPenPat(bgPat);
PaintRect(r);
PenNormal;
SetPort(savePort);
if gSAT.colorFlag then
SetGDevice(saveDev);
{end of Timebar}
if TickCount > lastSetStartTime + kGameTime then
begin
SATSoundPlay(baeH, 5, true);
{NewSet;}
if TickCount > gameStartTime + kGameTime then
begin
if score > settings^^.high then
begin
{settings^^.high := score;}
SATSoundEvents;
AskHigh;
ChangedResource(Handle(settings));
end;
{Kill all sprites}
while gSAT.sRoot <> nil do
SATKillSprite(gSAT.sRoot);
RedrawHighFace;
RedrawLastFace;
{Time for breaking some of my conventions! The stuff below should be done in "setup" and "handle"}
{routines, as recommened in the manual and done in other demos - but if we want to mess up the code,}
{we are free to do so! The sprites below set up their faces and speeds right here, and share a common}
{handling routine (SATBounce).}
{Make the "hello" sprite}
sp := SATNewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 2, @SetupDummy);
sp^.face := welcomeFace;
repeat
sp^.speed.h := SATRand(3) - 1
until sp^.speed.h <> 0;
repeat
sp^.speed.v := SATRand(3) - 1
until sp^.speed.v <> 0;
sp^.hotRect := sp^.face^.iconMask.bounds;
sp^.task := @ZoomWelcome;
{High score sprite}
sp := SATNewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 4, @SetupDummy);
sp^.face := highFace;
repeat
sp^.speed.h := SATRand(7) - 3
until sp^.speed.h <> 0;
repeat
sp^.speed.v := SATRand(3) - 1
until sp^.speed.v <> 0;
sp^.hotRect := sp^.face^.iconMask.bounds;
{Last score sprite}
sp := SATNewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 3, @SetupDummy);
sp^.face := lastFace;
repeat
sp^.speed.h := SATRand(7) - 3
until sp^.speed.h <> 0;
repeat
sp^.speed.v := SATRand(3) - 1
until sp^.speed.v <> 0;
sp^.hotRect := sp^.face^.iconMask.bounds;
SATSetPortScreen;
SATRedraw; {Just to make sure killed sprites are erased}
gameRunning := false;
end;
end;
end;
if not gameRunning then
if gSAT.sRoot = nil then
begin
{Messy code for setting up the "hello" sprite - which is why I recommend the use of setup routines.}
sp := SATNewSprite(0, gSAT.offSizeH div 2, gSAT.offSizeV div 2, @SetupDummy);
sp^.face := welcomeFace;
repeat
sp^.speed.h := SATRand(3) - 1
until sp^.speed.h <> 0;
repeat
sp^.speed.v := SATRand(3) - 1
until sp^.speed.v <> 0;
sp^.hotRect := sp^.face^.iconMask.bounds;
sp^.task := @ZoomWelcome;
end;
end;
procedure InitHigh;
begin
settings := SettingsHnd(GetResource('Sett', 0));
if settings = nil then {Didn't exist - create it!}
begin
settings := SettingsHnd(NewHandle(Sizeof(SettingsRec)));
if settings = nil then
begin
SysBeep(1);
halt;
end;
settings^^.high := 0;
AddResource(handle(settings), 'Sett', 0, '');
end
else {Did exist - check the size!}
if GetHandleSize(Handle(settings)) < sizeof(SettingsRec) then
SetHandleSize(Handle(settings), sizeof(SettingsRec));
end;
procedure DoFileMenu (item: integer);
begin
case item of
newGameItem:
begin
score := 0;
gameRunning := true;
gameStartTime := TickCount;
lastSetStartTime := TickCount;
setCount := 0;
NewSet;
ObscureCursor; {Hide the cursor until the mouse is moved.}
end;
clearHighItem:
if SATQuestionStr('Set the high score to zero?') then
begin
settings^^.high := 0;
ChangedResource(handle(settings));
end;
otherwise
SkelWhoa;
end;
end;
procedure DoShapeMenu (item: integer);
const
wide = 1;
tall = 2;
var
p: Point;
begin
p := gSAT.wind.port^.portRect.botRight;
case item of
wide:
if gSAT.wind.port^.portRect.bottom > gSAT.wind.port^.portRect.right then
begin
CheckItem(shapeMenu, wide, true);
CheckItem(shapeMenu, tall, false);
SizeWindow(gSAT.wind.port, p.v, p.h, false); {swap size}
SATKill;
SetupSAT(gSAT.wind.port);
gameRunning := false;
end;
tall:
if gSAT.wind.port^.portRect.bottom < gSAT.wind.port^.portRect.right then
begin
CheckItem(shapeMenu, tall, true);
CheckItem(shapeMenu, wide, false);
SizeWindow(gSAT.wind.port, p.v, p.h, false); {swap size}
SATKill;
SetupSAT(gSAT.wind.port);
gameRunning := false;
end;
otherwise
SysBeep(1);
end;{case}
end;
procedure SetUpMenus;
begin
SkelApple('About CollisionIII…', @DoAbout);
fileMenu := GetMenu(fileMenuRes);
if fileMenu = nil then
Barf;
if SkelMenu(fileMenu, @DoFileMenu, nil, true) then
;
shapeMenu := GetMenu(shapeMenuRes);
if shapeMenu = nil then
Barf;
if SkelHMenu(shapeMenu, @DoShapeMenu, nil) then {Install as hierarcical menu}
;
CheckItem(shapeMenu, 1, true); {Check "wide"}
end;
begin
SkelInit(6, nil);
SkelSetSleep(0); {Tell TransSkel that we want attention as often as possible.}
SetupMenus;
SetupWindow;
InitHigh;
InitSpriteFaces;
InitScoreFace;
InitPlayerFaces;
SkelBackground(@DirtyWork);
lastTime := TickCount;
{$IFC UNDEFINED THINK_PASCAL}
qd.randSeed := TickCount;
{$ELSEC}
randSeed := TickCount;
{$ENDC}
Synth; {Build sounds!}
SATSoundShutup;
SkelMain;
SkelClobber;
SATSoundShutup;
end.